home *** CD-ROM | disk | FTP | other *** search
/ Info-Mac 4 / Info_Mac IV CD-ROM (Pacific HiTech Inc.)(August 1994).iso / Development / Source / DBL Pascal Library / ErrSignal / ErrSignal.a < prev    next >
Text File  |  1992-04-26  |  24KB  |  912 lines
  1.     TITLE    'ErrSignal Unit Implementation'
  2.     COMMENT    'ErrSignal v2.0a6, Copyright © 1989, 1991, 1992 David B. Lamkins'
  3.  
  4. ; Revisions
  5. ;    1.0    A long time ago…
  6. ;    2.0a1    03/29/91
  7. ;    2.0a2    06/12/91 Fixed SignalRes and TrimCatchDepth.
  8. ;    2.0a3    07/29/91 Added SignalWhen, SignalUnless, and IdentifySignaller.
  9. ;    2.0a4    09/18/91 Added SignalDebugLevel.
  10. ;    2.0a5    09/30/91 Added SignalNIL and SignalNILRes.
  11. ;    2.0a6    03/24/92 Added RegisterCleanupAction, Cleanup, and Ignore.
  12. ;            Fixed ReSignal and PassSignal (and variants of both)
  13. ;            to dispose the catch that reached current handler.
  14. ;            Fixed stack protocol in SignalNIL and SignalNILRes.
  15. ;            Corrected SP adjustment in SignalRes.
  16. ;    2.0a7    04/25/92 Moved debugger check into InitSignals. Changed signal
  17. ;            "protocol errors" to signal sigFail, rather than
  18. ;            invoking SigDeath. Replaced SignalDebugLevel with
  19. ;            SetSignalStops. Corrected stack for FreeCatch call in
  20. ;            ReSignalDO.
  21. ;
  22. ; Asm ErrSignal.a
  23. ;
  24. ; Formatted for Courier 10, tabs every 8
  25. ;
  26. ;
  27. ; ErrSignal unit interface:
  28. ;    PROCEDURE InitSignals (failCode: Integer);
  29. ;    FUNCTION  CatchSignal: Integer;
  30. ;    FUNCTION  IdentifySignaller: Longint;
  31. ;    PROCEDURE Signal (code: Integer);
  32. ;    PROCEDURE SignalWhen (code: Integer; test: Boolean);
  33. ;    PROCEDURE SignalUnless (code: Integer; test: Boolean);
  34. ;    PROCEDURE SignalMem;
  35. ;    PROCEDURE SignalRes;
  36. ;    PROCEDURE SignalNIL (p: UNIV Ptr);
  37. ;    PROCEDURE SignalNILRes (h: UNIV Handle);
  38. ;    PROCEDURE ReSignal;
  39. ;    PROCEDURE FreeCatch;
  40. ;    PROCEDURE SignalHandlerDone;
  41. ;    FUNCTION  CatchInBlock: Boolean;
  42. ;    PROCEDURE TerminateSignalHandler;
  43. ;    PROCEDURE PassSignal (code: Integer);
  44. ;    PROCEDURE PassMemSignal;
  45. ;    PROCEDURE PassResSignal;
  46. ;    FUNCTION  CatchDepth: Integer;
  47. ;    PROCEDURE TrimCatchMemory;
  48. ;    FUNCTION  LastSignalCode: Integer;
  49. ;    FUNCTION  HandlingSignal: Boolean;
  50. ;    CONST
  51. ;        esStopInTHINKProject = 128;
  52. ;        esStopInApplication = 64;
  53. ;        esStopAtSignal = 4;
  54. ;        esStopAtReSignal = 2;
  55. ;        esStopAtError = 1;
  56. ;    FUNCTION  SetSignalStops (stopsMask: Integer): Integer;
  57. ;    FUNCTION  RegisterCleanupAction (p: ProcPtr): Integer;
  58. ;    PROCEDURE Cleanup (value: UNIV Longint; action: Integer);
  59. ;    PROCEDURE Ignore (value: UNIV Longint);
  60. ;
  61. ;    VAR SigGlobals:OPAQUE;    { not declared in the Pascal interface… }
  62. ;
  63. ; Derived from Apple Macintosh Technical Note #88, Version 1.0 by Rick Blair.
  64. ; Adapted for THINK Pascal by David B. Lamkins.  Should work with other
  65. ; Pascal systems without modification.
  66. ;    1)  A6 no longer modified by InitSignals, now saved for comparison
  67. ;    2)  No static initializers in SigGlobals
  68. ;    3)  Makes check for no catches in scope
  69. ;    4)  Invokes _SysError for fatal errors
  70. ;    5)  Checks for nil handle in SigSetup
  71. ;    6)  InitSignal has failure code as argument
  72. ;    7)  Added a ReSignal mechanism
  73. ;    8)  Allows use of CatchSignal in expressions
  74. ;    9)  Sanity-checks A6 during frame search
  75. ;    10) Catch table will shrink as well as expand
  76. ;    11) Module structure satisfies THINK Pascal .o converter
  77. ;    12) Intra-unit references optimized
  78. ;    13) Added calls to signal Memory and Resource Manager errors
  79. ;    14) Added calls to pass along various re-signal codes
  80. ;    15) Added in-handler flag and HandlingSignal inquiry function
  81. ;    16) Added CatchDepth function
  82. ;    17) Added TrimCatchMemory procedure to minimize catch storage
  83. ;    18) Added LastSignalCode function
  84. ;    19) Added CatchInBlock to inquire about presence of catch
  85. ;    20) Added SignalHandlerDone to use at end of handler
  86. ;    21) Added TerminateSignalHandler to finish and disestablish handler
  87. ;    22) Allow non-local Exit(…) and Goto … by cutting back catch table
  88. ;    23) Added SignalWhen and SignalUnless.
  89. ;    24) Added IdentifySignaller to give return address of last signaller.
  90. ;    25) Added SignalDebugLevel to enable break into debugger on signal.
  91. ;    26) Added SignalNIL to signal memFullError on a nil pointer or handle.
  92. ;    27) Added SignalNILRes to signal resNotFound (nil handle and no error) or ResError.
  93. ;    28) Added RegisterCleanupAction and Cleanup to streamline use of multiple catches.
  94. ;    29) Added Ignore to discard a scalar argument.
  95. ;
  96. ; The following will cause fatal errors:
  97. ;    1) Failure to initialize using InitSignal (unpredictable)
  98. ;    2) FreeSignal with no catches in scope
  99. ;    3) Signal… with no catches in scope, or inside an active handler
  100. ;    4) ReSignal with no catches in scope
  101. ;    5) Pass…Signal outside an active handler
  102. ;    6) TerminateSignalHandler outside an active handler or its scope
  103. ;    7) SignalHandlerDone outside an active handler
  104. ;    8) Not enough memory for new catch, and no other catch active
  105. ;    9) Not enough memory for new cleanup action, and no catch active
  106.  
  107.  
  108.     PRINT    OFF
  109.     INCLUDE    'Traps.a'
  110.     INCLUDE    'SysEqu.a'
  111.     INCLUDE    'ToolEqu.a'
  112.     INCLUDE    'SysErr.a'
  113.     PRINT    ON
  114.                         
  115. SigChunks    EQU    5     ;number of elements to expand by
  116. FrameRet    EQU    4     ;return address for frame (off A6)
  117.  
  118. ; Registers are saved to allow CatchSignal to be used in an expression.  The
  119. ; compiler does not expect D0-D2/A0-A1 to be preserved across calls.  A6 is
  120. ; restored by the frame search, but we use the saved value for comparison.
  121. ; THE FPU REGISTERS ARE NOT SAVED!
  122.  
  123. RegList    REG    D3-D7/A2-A7
  124. NumRegs    EQU    11
  125.  
  126. ; A catch needs the following information, which is kept in a table of catches:
  127.  
  128. SigElement    RECORD    0
  129. SigRegs        DS.L    NumRegs-2    ; Regs D3-D7/A2-A5 put here by MOVEM
  130. SigFP        DS.L    1        ; A6 is put here by MOVEM
  131. SigSP        DS.L    1        ; SP is put here by MOVEM
  132. SigRetAddr    DS.L    1        ; Return address of CatchSignal call
  133. SigFRet        DS.L    1        ; Return address of enclosing routine
  134. SigCUValue    DS.L    1        ; Value to be "cleaned up"
  135. SigCUAction    DS.W    1        ; Action to take during cleanup
  136. SigElSize    EQU    *        ; The size of this record
  137.         ENDR
  138.  
  139. ; The signal unit has these private globals:
  140.  
  141. SigGlobals     RECORD
  142. SigEnd        DS.L    1    ; Offset to the end of the catch table
  143. SigNow        DS.L    1    ; Offset to the most recently established catch
  144. SigHandle    DS.L    1    ; Handle to the catch table
  145. SigOuterA6    DS.L    1    ; Value of A6 at the time of InitSignals call
  146. SigFailCode    DS.W    1    ; Code to be signalled for fatal errors
  147. SigLastCode    DS.W    1    ; Last code signalled
  148. SigActive    DS.B    1    ; Handler active flag
  149. SigInProject    DS.B    1    ; “In THINK Pascal project” flag
  150. Sig32Bit    DS.B    1    ; Running in 32-bit environment
  151. SigSysDebugger    DS.B    1    ; Debugger is present
  152. SigStopsMask    DS.W    1    ; Signal stops control mask
  153. SignalRA    DS.L    1    ; Return address of any Signal… call
  154. SigCUProcs    DS.L    1    ; Handle to the cleanup procs table
  155. SigCUNextID    DS.W    1    ; ID of next cleanup procs action
  156.         ENDR    
  157.  
  158.     PROC
  159.     BRANCH    SHORT
  160.     
  161.     EXPORT    InitSignals,CatchSignal,FreeCatch
  162.     EXPORT    ReSignal,Signal,SignalMem,SignalRes
  163.     EXPORT    PassSignal,PassMemSignal,PassResSignal
  164.     EXPORT    SignalWhen,SignalUnless,IdentifySignaller
  165.     EXPORT    LastSignalCode,HandlingSignal
  166.     EXPORT    SignalHandlerDone,TerminateSignalHandler
  167.     EXPORT    CatchInBlock,CatchDepth,TrimCatchMemory
  168.     EXPORT    SetSignalStops,SignalNIL,SignalNILRes
  169.     EXPORT    RegisterCleanupAction,Cleanup,Ignore
  170.  
  171.     WITH    SigElement,SigGlobals
  172.     
  173. ;PROCEDURE InitSignals (failCode: Integer);
  174. ;
  175. ; This must be called from the outermost scope of the program which will
  176. ; use signals.  Typically, this is the body of the main program.  InitSignals
  177. ; creates the catch table and initializes globals.  SigNow is initialized
  178. ; with a negative value to indicate an empty table.  SigEnd is initialized
  179. ; with an offset to the end of the table.  SigOuterA6 saves the A6 value
  180. ; for later use in finding the outermost scope.  Failure to call InitSignals
  181. ; is unpredictably fatal - no guarantee of SigDeath.  The argument will be
  182. ; used as the code to signal failure to establish a catch and to indicate
  183. ; fatal errors - it should be chosen to be distinguishable from Macintosh
  184. ; system error codes.
  185. ;
  186. ; For use in the THINK Pascal project environment, InitSignals must be called
  187. ; while the application's resource file is still current — we rely on the
  188. ; observation that there is no CODE 0 resource in the application while
  189. ; running in the project environment.
  190.  
  191. MacJmp    EQU    $120    ; Pointer to debugger; flags in hi byte if 24-bit addr
  192. Dbg32    EQU    $BFF    ; Debugger flags if 32-bit addressing is enabled
  193.     
  194. InitSignals
  195.     ; Init private globals
  196.     MOVEA.L    (SP)+,A1
  197.     MOVE.W    (SP)+,SigFailCode
  198.     MOVE.L    A1,-(SP)        ; Set up for RTS later
  199.     MOVE.L    #-SigElSize,SigNow
  200.     MOVE.L    A6,SigOuterA6
  201.     CLR.W    SigLastCode
  202.     SF    SigActive
  203.     CLR.W    SigStopsMask
  204.     CLR.W    SigCUNextID
  205.     
  206.     ; Test for 32-bit addressing
  207.     MOVE.L    #$FF000000,D0
  208.     _StripAddress
  209.     TST.L    D0
  210.     SNE.B    Sig32Bit
  211.     
  212.     ; Create the catch table
  213.     MOVE.L    #SigChunks*SigElSize,D0
  214.     MOVE.L    D0,SigEnd
  215.     _NewHandle
  216.     MOVE.L    A0,SigHandle
  217.     
  218.     ; Create the cleanup procs table
  219.     CLR.L    D0
  220.     _NewHandle
  221.     MOVE.L    A0,SigCUProcs
  222.     
  223.     ; Test for THINK Pascal project environment
  224.     SF    ResLoad
  225.     SUBQ.L    #4,SP
  226.     MOVE.L    #'CODE',-(SP)
  227.     CLR.W    -(SP)
  228.     _Get1Resource
  229.     MOVE.L    (SP)+,D0
  230.     SEQ    SigInProject
  231.     ST    ResLoad
  232.     
  233.     ; Test for system debugger
  234.     LEA    MacJmp,A0
  235.     TST.B    Sig32Bit
  236.     BEQ    InitDebuggerCheck
  237.     LEA    Dbg32,A0
  238.     
  239. InitDebuggerCheck
  240.     BTST.B    #5,(A0)
  241.     SNE.B    SigSysDebugger    
  242.     RTS
  243.     
  244. ;FUNCTION SetSignalStops (stopsMask: Integer): Integer;
  245. ;
  246. ;SetSignalStops sets the conditions under which a signal will cause a break
  247. ;into the low-level debugger. The conditions are determined by the es...
  248. ;masks. Note that a break, when enabled, only happens if there is
  249. ;a low-level debugger present in the system. SetSignalStops returns the
  250. ;previous mask.
  251.  
  252. SetSignalStops
  253.     MOVE.L    (SP)+,A0
  254.     MOVE.W    SigStopsMask,D0
  255.     MOVE.W    (SP)+,SigStopsMask
  256.     MOVE.W    D0,(SP)
  257.     JMP    (A0)
  258.     
  259. ; SigBreak conditionally breaks into the low-level debugger before signalling.
  260. ; The condition is based on the environment (THINK Pascal project vs compiled
  261. ; application), the presence of a debugger, and the stop mask (set by the
  262. ; last call to SetSignalStops.
  263.  
  264. esStopInTHINKProject    EQU    128
  265. inTHINKProjectBit    EQU    7
  266. esStopInApplication    EQU    64
  267. inApplicationBit    EQU    6
  268. esStopAtSignal        EQU    4
  269. esStopAtReSignal    EQU    2
  270. esStopAtError        EQU    1
  271.  
  272. BreakMsg
  273.     DC.B    'Signal stop'
  274.     
  275. SigBreak
  276.     ; On entry, D1 indicates condition (signal, resignal, error).
  277.     ; D0 is preserved.
  278.     MOVE.W    D0,-(SP)
  279.     MOVE.W    SigStopsMask,D0
  280.     MOVE.W    D0,D2
  281.     ANDI.W    #esStopInThinkProject+esStopInApplication,D2
  282.     BEQ    SigBreakDone
  283.     
  284.     TST.B    SigInProject
  285.     BEQ    InApp
  286.     
  287.     BTST.L    #inTHINKProjectBit,D1
  288.     BEQ    SigBreakDone
  289.     
  290. InApp
  291.     BTST.L    #inApplicationBit,D1
  292.     BEQ    SigBreakDone
  293.     
  294.     AND.W    D0,D1
  295.     BEQ    SigBreakDone
  296.     
  297.     PEA    BreakMsg
  298.     _DebugStr
  299. SigBreakDone
  300.     MOVE.W    (SP)+,D0
  301.     RTS
  302.     
  303. ;FUNCTION RegisterCleanupAction (p: ProcPtr): Integer;
  304. ;
  305. ; RegisterCleanupAction adds a routine to the cleanup action table and returns
  306. ; the ID of the action (to be used in subsequent calls to Cleanup). If the table
  307. ; can not hold the entry, a memory error is signalled. This supports a maximum
  308. ; of 32767 entries; a negative number is returned if this limit is exceeded.
  309. ; The routine MUST reside in a locked segment or be referenced through a jump
  310. ; table entry!
  311. ;
  312. ; The action proc is declared as:
  313. ;  PROCEDURE CleanupActionProc (value: UNIV Longint);
  314.  
  315. RegisterCleanupAction
  316.     ; Prepare the return value
  317.     MOVE.W    SigCUNextID,D0
  318.     MOVE.W    D0,8(SP)
  319.     BMI    RegisterCleanupActionDone
  320.     
  321.     ; Grow the table to hold another entry
  322.     EXT.L    D0
  323.     LSL.L    #2,D0
  324.     MOVE.L    D0,D1
  325.     ADDQ.L    #4,D0
  326.     MOVEA.L    SigCUProcs,A0
  327.     _SetHandleSize
  328.     TST.W    D0
  329.     BNE.W    SignalD0
  330.     
  331.     ; Stuff the proc pointer into the new entry
  332.     MOVE.L    4(SP),D0
  333.     MOVEA.L    (A0),A0
  334.     MOVE.L    D0,(A0,D1.L)
  335.     
  336.     ; Update the ID for the next entry
  337.     MOVE.W    8(SP),D0
  338.     ADDQ.W    #1,D0        ; This will wrap around from 32767 to -32768
  339.     MOVE.W    D0,SigCUNextID
  340.     
  341. RegisterCleanupActionDone
  342.     ; Adjust the stack and return
  343.     MOVEA.L    (SP)+,A0
  344.     ADDQ.L    #4,SP
  345.     JMP    (A0)
  346.     
  347. ;PROCEDURE Cleanup (value: UNIV Longint; action: Integer);
  348. ;
  349. ; Cleanup establishes a catch and records a value and the ID of an action proc
  350. ; (as returned by RegisterCleanupAction). When a signal reaches this catch, the
  351. ; action proc (if defined) is applied to the saved value. The action proc executes
  352. ; in the context of a signal handler. The cleanup handler finishes by propagating
  353. ; the signal to the next handler.
  354. ;
  355. ; The action proc is declared as:
  356. ;  PROCEDURE CleanupActionProc (value: UNIV Longint);
  357.  
  358. Cleanup
  359.     ; Establish a catch at current lexical level
  360.     SUBQ.L    #2,SP            ; First, set the catch
  361.     BSR    CatchSignalInternal
  362.     MOVEA.L    SigHandle,A0        ; Point A0 at the new catch entry
  363.     MOVEA.L    (A0),A0
  364.     MOVE.L    SigNow,D0
  365.     ADDA.L    D0,A0
  366.     TST.W    (SP)+            ; Check the CatchSignalResult
  367.     BNE    CleanupDoCleanup
  368.     
  369.     ; Stuff value and action ID into new catch table entry
  370.     MOVE.W    4(SP),D0
  371.     MOVE.W    D0,SigCUAction(A0)
  372.     MOVE.L    6(SP),D0
  373.     MOVE.L    D0,SigCUValue(A0)
  374.     
  375.     ; Adjust the stack and return
  376.     MOVE.L    (SP)+,A0
  377.     ADDQ.L    #6,SP
  378.     JMP    (A0)
  379.     
  380. CleanupDoCleanup
  381.     ; This is the signal handler - apply cleanup action to saved value
  382.     SUBI.L    #SigElSize,D0        ; Remove the top catch info
  383.     MOVE.L    D0,SigNow
  384.     MOVE.W    SigCUAction(A0),D0    ; Get the cleanup action ID
  385.     BMI    CleanupResignal        ; Bail out if action ID < 0
  386.     
  387.     CMP.W    SigCUNextID,D0
  388.     BHS    CleanupResignal        ; Bail out if no action with matching ID
  389.     
  390.     ; Get the address of the cleanup handler and call it
  391.     MOVEA.L    SigCUProcs,A1
  392.     MOVEA.L    (A1),A1
  393.     LSL    #2,D0
  394.     MOVEA.L    (A1,D0.W),A1
  395.     MOVE.L    SigCUValue(A0),D0
  396.     MOVE.L    D0,-(SP)
  397.     JSR    (A1)
  398.     
  399. CleanupResignal
  400.     ; Continue on to the next handler…
  401.     ; Don't bother too much about the stack - we never return
  402.     MOVE.W    SigLastCode,-(SP)
  403.     CLR.L    -(SP)            ; Fake RA gets discarded, anyhow
  404.     BRA.W    SignalInternal
  405.     
  406. ;FUNCTION CatchSignal: Integer;
  407. ;
  408. ; CatchSignal must be called from within a procedure or function which has
  409. ; a stack frame (created by a LINK #n,A6 instruction).  CatchSignal establishes
  410. ; a catch by creating a new catch table entry, saving the SP of CatchSignal's
  411. ; caller, the CatchSignal return address and the return address of CatchSignal's
  412. ; caller, patching in the address of SigPop in place of CatchSignal's caller's
  413. ; return address, and finally returning a zero result.
  414. ;
  415. ; There are a few exception conditions which must be considered.  If the catch
  416. ; table is missing, a fatal error is indicated via SigDeath.  If the catch
  417. ; table is full, CatchSignal attempts to expand it to make room for additional
  418. ; entries, and signals (using Signal, of course) an error if the expansion of
  419. ; the catch table is unsuccessful, meaning that the catch could not be
  420. ; established.  If the catch table is not more than half full and is larger than
  421. ; its initial size, its size will be reduced to half (rounding down) the number
  422. ; of chunks plus one.  Finally, if CatchSignal is called at the same lexical
  423. ; level as InitSignals, it is unnecessary to patch in SigPop.
  424.  
  425. CatchSignal
  426.     ; Is this OK to do?
  427.     LEA    SigPop,A0
  428.     CMPA.L    FrameRet(A6),A0
  429.     BEQ.W    SigDeath
  430.     
  431. CatchSignalInternal
  432.     LEA    SigPop,A0
  433.     
  434.     ; Grab return address
  435.     MOVEA.L    (SP)+,A1
  436.     
  437.     ; Get handle to catch table
  438.     MOVE.L    SigHandle,D0
  439.     BEQ.W    SigDeath
  440.     
  441.     ; Check for table full
  442.     MOVEA.L    D0,A0
  443.     MOVE.L    SigNow,D0
  444.     ADDI.L    #SigElSize,D0
  445.     MOVE.L    D0,SigNow
  446.     CMP.L    SigEnd,D0
  447.     BEQ    ChangeSize
  448.     
  449.     ; Check for table underutilization
  450.     MOVE.L    SigEnd,D1
  451.     ASR.L    #1,D1
  452.     SUB.L    D0,D1
  453.     BLT    SetCatch
  454.     
  455.     ; Halve the number of chunks, rounding down
  456.     MOVE.L    #SigChunks*SigElSize,D2
  457.     DIVU    D2,D1
  458.     MULU    D2,D1
  459.     MOVE.L    D1,D0
  460.     
  461. ChangeSize
  462.     ; Add a chunk and try to change catch table size
  463.     ADD.L    D2,D0
  464.     CMP.L    D2,D1
  465.     BEQ    SetCatch
  466.     
  467.     MOVE.L    D0,SigEnd
  468.     _SetHandleSize
  469.     BNE    NoCatchSet
  470.  
  471.     MOVE.L    SigNow,D0
  472.     
  473. SetCatch
  474.     ; Point to new catch table entry
  475.     MOVEA.L    (A0),A0
  476.     ADDA.L    D0,A0
  477.     
  478.     ; Save regs and return address in catch entry
  479.     MOVEM.L    RegList,SigRegs(A0)
  480.     MOVE.L    A1,SigRetAddr(A0)
  481.     
  482.     ; Test for outermost lexical level
  483.     CMPA.L    SigOuterA6,A6
  484.     BEQ    CatchSet
  485.     
  486.     ; Only patch in SigPop once
  487.     MOVE.L    A0,-(SP)
  488.     LEA    SigPop,A0
  489.     CMP.L    FrameRet(A6),A0
  490.     MOVEA.L    (SP)+,A0
  491.     BEQ    CatchSet
  492.  
  493.     ; Patch in SigPop to precede caller's exit
  494.     MOVE.L    FrameRet(A6),SigFRet(A0)
  495.     LEA    SigPop,A0
  496.     MOVE.L    A0,FrameRet(A6)
  497.     
  498. CatchSet
  499.     ; Return a zero, meaning "catch established"
  500.     CLR.W    (SP)
  501.     JMP    (A1)
  502.     
  503. NoCatchSet
  504.     ; Restore catch globals, signal error "failed to establish catch"
  505.     MOVE.L    SigNow,SigEnd
  506.     MOVEQ.L    #SigElSize,D0
  507.     SUB.L    D0,SigNow
  508.     MOVE.W    SigFailCode,D0
  509.     BRA    SigError
  510.     
  511. ;PROCEDURE SignalHandlerDone;
  512. ;
  513. ; Call this from a signal handler that's finished its work, but stays around.
  514.  
  515. SignalHandlerDone
  516.     TST.B    SigActive
  517.     BEQ    SigError
  518.     
  519.     SF    SigActive
  520.     RTS
  521.     
  522. ;PROCEDURE TerminateSignalHandler;
  523. ;
  524. ; Call this from a signal handler that's finished if you want to remove it.
  525.  
  526. TerminateSignalHandler
  527.     BSR    SignalHandlerDone
  528.     ; Fall through to FreeCatch…
  529.  
  530. ;PROCEDURE FreeCatch;
  531. ;
  532. ; FreeCatch is used to disestablish the most recent catch.  It is fatal to
  533. ; call FreeCatch with no catches in scope.  FreeCatch unhooks the SigPop
  534. ; address from the stack, restores the prior return address for the calling
  535. ; procedure, and discards the most recent catch table entry.
  536.  
  537. FreeCatch
  538.     ; Is it OK to do this?
  539.     LEA    SigPop,A0
  540.     CMPA.L    FrameRet(A6),A0
  541.     BNE    SigError
  542.     
  543.     ; Unhook SigPop and remove the catch from the table
  544.     BSR    SigSetup
  545.     MOVE.L    SigFRet(A0),FrameRet(A6)
  546.     SUBI.L    #SigElSize,D0
  547.     MOVE.L    D0,SigNow
  548.     RTS
  549.     
  550. ; SigPop is used to remove the most recent catch entry from the table.  It
  551. ; is patched into the procedure's return address by CatchSignal.  When invoked,
  552. ; it removes the last entry from the catch table and transfers control to the
  553. ; procedure's normal return address.  In the case of nested catches within a
  554. ; lexical scope, this will happen several times before the real return address
  555. ; is reached.
  556.  
  557. SigPop
  558.     BSR    SigSetup    ; Our caller unlinked frame before we got here…
  559.     MOVEA.L    SigElSize+SigFRet(A0),A0
  560.                 ; …so find the catch entry we just removed.
  561.     JMP    (A0)
  562.     
  563. ;PROCEDURE PassSignal (code: Integer);
  564. ;
  565. ; PassSignal is similar to ReSignal, but allows a different result to be passed.
  566.  
  567. PassSignal
  568.     MOVEA.L    (SP)+,A0
  569.     MOVE.W    (SP)+,D0
  570.     MOVE.L    A0,-(SP)
  571.     BRA    ReSignalD0
  572.  
  573. ;PROCEDURE PassMemSignal;
  574. ;
  575. ; This is like calling PassSignal(MemError)
  576.  
  577. PassMemSignal
  578.     MOVE.W    MemErr,D0
  579.     BRA    ReSignalD0
  580.     
  581. ;PROCEDURE PassResSignal;
  582. ;
  583. ; This is like calling PassSignal(ResError)
  584.  
  585. PassResSignal
  586.     SUBQ.L    #2,SP
  587.     _ResError
  588.     MOVE.W    (SP)+,D0
  589.     BRA    ReSignalD0
  590.  
  591. ;PROCEDURE SignalNIL (p: UNIV Ptr);
  592. ;
  593. ; This signals a memFullErr if its argument is NIL.
  594.  
  595. SignalNIL
  596.     MOVE.W    #memFullErr,D0
  597.     MOVEA.L    (SP)+,A0
  598.     MOVE.L    (SP)+,D1
  599.     MOVE.L    A0,-(SP)
  600.     TST.L    D1
  601.     BEQ    SignalD0
  602.     
  603. SignalNotNIL
  604.     RTS
  605.     
  606. ;PROCEDURE SignalNILRes (h: UNIV Handle);
  607. ;
  608. ; If its argument is NIL, this signals either the non-zero result
  609. ; of ResError or resNotFound.
  610.  
  611. SignalNILRes
  612.     MOVEA.L    (SP)+,A0
  613.     MOVE.L    (SP)+,D1
  614.     MOVE.L    A0,-(SP)
  615.     TST.L    D1
  616.     BNE    SignalNotNIL
  617.     
  618.     SUBQ.L    #2,SP
  619.     _ResError
  620.     MOVE.W    (SP)+,D0
  621.     BNE    SignalD0
  622.     
  623.     MOVE.W    #resNotFound,D0
  624.     BRA    SignalD0
  625.         
  626. ; SigSetupDone is the tail of SigSetup — see below…
  627.  
  628. SigSetupDone
  629.     ; Point to the entry we found, and return its offset
  630.     ADDA.L    D0,A0
  631.     MOVE.L    D0,SigNow
  632.     RTS
  633.     
  634. ; SigError is used to signal that we did something to violate signal protocol.
  635.  
  636. SigError
  637.     MOVEQ    #esStopAtError,D1
  638.     BSR.W    SigBreak
  639.     MOVE.W    SigFailCode,-(SP)
  640.     BSR    Signal
  641.     
  642.     ; So long as SigFailCode<>0, we'll never reach here
  643.     ; Fall through to SigDeath…
  644.     
  645. ; SigDeath invokes the Macintosh SysError handler to indicate a fatal error.
  646.  
  647. SigDeath
  648.     MOVE.W    SigFailCode,D0
  649.     _SysError
  650.     _ExitToShell    ; Just in case…
  651.     
  652. ; SigSetup initializes A0 to point to the current entry in the catch table,
  653. ; as determined by the SigNow global and D0 to the value of SigNow.  If there
  654. ; is anything amiss with the table or if there are no active catches, SigDeath
  655. ; is invoked to indicate a fatal error.
  656. ;
  657. ; SigSetup discards any catch table entries that have been abandoned by a
  658. ; non-local exit (caused by Exit(…) or Goto …) discarding one or more stack
  659. ; frames without calling SigPop.
  660.  
  661. SigSetup
  662.     ; Make sure we have a catch table
  663.     MOVE.L    SigHandle,D0
  664.     BEQ    SigDeath
  665.     
  666.     ; Get ready to search the table
  667.     MOVEA.L    D0,A0
  668.     MOVEA.L    (A0),A0
  669.     MOVE.L    SigNow,D0
  670.     
  671. SigSetupClean
  672.     ; Fail if we don't find our entry in the table
  673.     BMI    SigDeath
  674.     
  675.     ; We're looking for a table entry with an A6 that's still accessible
  676.     CMPA.L    SigFP(A0,D0.L),A6
  677.     BLS    SigSetupDone
  678.     
  679.     SUBI.L    #SigElSize,D0
  680.     BRA    SigSetupClean
  681.     
  682. ;PROCEDURE ReSignal;
  683. ;
  684. ; ReSignal is used to send the same signal sent by the most recent call to
  685. ; Signal.  It is erroneous to call this outside of an active signal handler.
  686. ; ReSignal is provided mainly as a syntactic convenience, to be used in the
  687. ; 'otherwise' case of a nested handler.
  688.  
  689. ReSignal
  690.     ; Get the last signalled code
  691.     MOVE.W    SigLastCode,D0
  692.     
  693. ReSignalD0
  694.     MOVEQ    #esStopAtReSignal,D1
  695.     BSR.W    SigBreak
  696.     ; Make sure it's OK to do this
  697.     TST.B    SigActive
  698.     BEQ    SigError
  699.     
  700.     ; Get rid of the catch that brought us here
  701.     MOVEA.L    (SP)+,A0
  702.     MOVE.W    D0,-(SP)
  703.     MOVE.L    A0,-(SP)
  704.     BSR.W    FreeCatch
  705.     
  706.     ; Set up for entry into Signal
  707.     BRA    SignalInternal
  708.     
  709. SignalD0
  710.     MOVEA.L    (SP)+,A0
  711.     MOVE.W    D0,-(SP)
  712.     MOVE.L    A0,-(SP)
  713.     ; Continue into Signal…
  714.     
  715. ;PROCEDURE Signal (code: Integer);
  716. ;
  717. ; Signal with a zero argument simply returns.  Invoked with a nonzero argument,
  718. ; Signal causes a transfer of control to the active (i.e. not disestablished
  719. ; using a FreeSignal call) catch most recently established by a CatchSignal
  720. ; call.  In this case, the argument passed to Signal is 'returned' by the
  721. ; CatchSignal call - control does not return to the statement following Signal.
  722.     
  723. Signal
  724.     ; Break into the debugger if required
  725.     MOVEQ    #esStopAtSignal,D1
  726.     BSR.W    SigBreak
  727.     
  728.     ; Get the RA to identify the signaller
  729.     MOVE.L    (SP),SignalRA
  730.     
  731.     ; Make sure it's OK to do this
  732.     TST.B    SigActive
  733.     BNE    SigError
  734.     
  735. SignalInternal
  736.     ; Get the signal argument
  737.     MOVE.W    4(SP),D1
  738.     MOVE.W    D1,SigLastCode
  739.     BNE    SigFind
  740.     
  741.     ; Ignore zero argument
  742.     MOVEA.L    (SP),A0
  743.     ADDQ.L    #6,SP
  744.     JMP    (A0)
  745.     
  746.     ; Search stack for active catch, fatal if not found or stack corrupted
  747. SigFind
  748.     BSR    SigSetup
  749.     BRA    SigLoop1
  750.  
  751. SigLoop
  752.     CMPA.L    SigOuterA6,A6
  753.     BEQ    SigDeath
  754.     
  755.     CMPA.L    CurStackBase,A6
  756.     BHI    SigDeath
  757.     
  758.     MOVE.L    A6,D0
  759.     BTST    #0,D0
  760.     BNE    SigDeath
  761.     
  762.     ; If we're in TP project, tell the debugger we're unwinding a frame
  763.     TST.B    SigInProject
  764.     BEQ    SigUnwind
  765.  
  766.     TRAP    #$7
  767.     
  768.     ; The debugger has probably clobbered A0 and moved memory…
  769.     MOVEA.L    SigHandle,A0
  770.     MOVEA.L    (A0),A0
  771.     MOVE.L    SigNow,D0
  772.     ADDA.L    D0,A0
  773.     
  774.     ; Unwind one stack frame, then see if that's enough
  775. SigUnwind
  776.     UNLK    A6
  777.     
  778. SigLoop1
  779.     CMPA.L    SigFP(A0),A6
  780.     BLO    SigLoop
  781.     
  782.     ST    SigActive
  783.  
  784.     ; Found frame of active catch, restore regs and invoke the catch    
  785. SigRestore
  786.     MOVEM.L    SigRegs(A0),RegList
  787.     MOVEA.L    SigRetAddr(A0),A0
  788.     MOVE.W    D1,(SP)
  789.     
  790.     ; Jump out to the catch with the signalled code
  791.     JMP    (A0)
  792.     
  793. ;PROCEDURE SignalMem;
  794. ;
  795. ; SignalMem is used to signal any error from the last Memory Manager call.
  796.  
  797. SignalMem
  798.     MOVE.W    MemErr,D0
  799.     BRA    SignalD0
  800.     
  801. ;PROCEDURE SignalRes;
  802. ;
  803. ; SignalRes is used to signal any error from the last Resource Manager call.
  804.  
  805. SignalRes
  806.     SUBQ.L    #2,SP
  807.     _ResError
  808.     MOVE.W    (SP)+,D0
  809.     BRA    SignalD0
  810.     
  811. ; DoCondSignal removes the 'test' argument and transfers to Signal.
  812.  
  813. DoCondSignal
  814.     MOVEA.L    (SP)+,A0
  815.     ADDQ.L    #2,SP
  816.     MOVE.L    A0,-(SP)
  817.     BRA    Signal
  818.     
  819. ;PROCEDURE SignalUnless (code: Integer; test: Boolean);
  820. ;
  821. ; SignalUnless is shorthand for “if not test then Signal(code)”.
  822.  
  823. SignalUnless
  824.     NOT.B    4(SP)
  825.     ; Continue into SignalWhen…
  826.  
  827. ;PROCEDURE SignalWhen (code: Integer; test: Boolean);
  828. ;
  829. ; SignalWhen is shorthand for “if test then Signal(code)”.
  830.  
  831. SignalWhen
  832.     BTST.B    #0,4(SP)
  833.     BNE    DoCondSignal
  834.     
  835.     MOVE.L    (SP),A0
  836.     ADDQ.L    #8,SP
  837.     JMP    (A0)
  838.     
  839. ;FUNCTION LastSignalCode: Integer
  840. ;
  841. ; Returns the last result passed to a catch, or noErr
  842.  
  843. LastSignalCode
  844.     MOVE.W    SigLastCode,4(SP)
  845.     RTS
  846.     
  847. ;FUNCTION HandlingSignal: Boolean
  848. ;
  849. ; Returns true only within an active signal handler
  850.  
  851. HandlingSignal
  852.     MOVE.B    SigActive,4(SP)
  853.     RTS
  854.     
  855. ;FUNCTION CatchInBlock: Boolean;
  856. ;
  857. ; CatchInBlock returns true only if there is a handler established at the
  858. ; current lexical level.
  859.  
  860. CatchInBlock
  861.     LEA    SigPop,A0
  862.     CMPA.L    FrameRet(A6),A0
  863.     SEQ.B    4(SP)
  864.     RTS
  865.     
  866. ;FUNCTION CatchDepth: Integer
  867. ;
  868. ; CatchDepth returns the number of active catch handlers.
  869.  
  870. CatchDepth
  871.     MOVE.L    SigNow,D0
  872.     DIVS    #SigElSize,D0
  873.     ADDQ.W    #1,D0
  874.     MOVE.W    D0,4(SP)
  875.     RTS
  876.     
  877. ;PROCEDURE TrimCatchMemory;
  878. ;
  879. ; TrimCatchMemory minimizes the size of the catch storage.
  880.  
  881. TrimCatchMemory
  882.     MOVEA.L    SigHandle,A0
  883.     MOVE.L    SigNow,D0
  884.     ADDI.L    #SigElSize,D0
  885.     CMPI.L    #SigChunks*SigElSize,D0
  886.     BLE    TrimDone
  887.     
  888.     _SetHandleSize
  889. TrimDone
  890.     RTS
  891.     
  892. ;FUNCTION IdentifySignaller: Longint
  893. ;
  894. ; Gives the return address of the last call to a Signal… routine.
  895.  
  896. IdentifySignaller
  897.     MOVE.L    SignalRA,4(SP)
  898.     RTS
  899.     
  900. ;PROCEDURE Ignore (value: UNIV Longint);
  901. ;
  902. ; This just discards the value passed to it. Saves you from allocating a variable…
  903.  
  904. Ignore
  905.     MOVEA.L    (SP)+,A0
  906.     ADDQ.L    #4,SP
  907.     JMP    (A0)
  908.     
  909. ; That's all there is, folks…
  910.  
  911.     END
  912.